home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / env / more-thread.scm < prev    next >
Text File  |  1995-10-13  |  3KB  |  113 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4. ; Glue to connect the threads package with command processor.
  5.  
  6. (define (threads)
  7.   (with-threads breakpoint))
  8.  
  9. (define (with-threads thunk)
  10.   (with-handler (simple-thread-condition-handler)
  11.     (lambda ()
  12.       (with-multitasking
  13.        (lambda ()
  14.      (with-keyboard-interrupt-thread (current-thread)
  15.        thunk))))))
  16.  
  17. (define-command-syntax 'start-threads "" "initiate multitasking"
  18.   '())
  19.  
  20. (define (start-threads)
  21.   (let ((context (user-context))
  22.     (env (environment-for-commands)))
  23.     (exit-command-processor
  24.      (lambda ()
  25.        (with-threads
  26.     (lambda ()
  27.       (start-command-processor
  28.        #f context
  29.        env
  30.        (lambda ()
  31.          (write-line "Multitasking started"
  32.              (command-output))))))))))
  33.  
  34.  
  35.  
  36. ; For using threads in a system that has a command processor.
  37. ; Interrupts will be disabled, I think, when the designated thread gets
  38. ; its signal.
  39.  
  40. (define (with-keyboard-interrupt-thread thread thunk)
  41.   (let ((save #f))
  42.     (dynamic-wind
  43.        (lambda ()
  44.      (set! save (vector-ref interrupt-handlers interrupt/keyboard))
  45.      (vector-set! interrupt-handlers
  46.               interrupt/keyboard
  47.               (lambda (ei)
  48.             (interrupt-thread thread
  49.               (lambda ()
  50.                 (signal 'interrupt interrupt/keyboard ei))))))
  51.        thunk
  52.        (lambda ()
  53.      (vector-set! interrupt-handlers interrupt/keyboard save)))))
  54.  
  55. (define interrupt/keyboard (enum interrupt keyboard))
  56.  
  57.  
  58. ; A simple handler for non-command-processor threads.
  59.  
  60. (define (simple-thread-condition-handler)
  61.   (let ((port (current-output-port)))
  62.     (lambda (c punt)
  63.       (cond ((or (error? c) (interrupt? c))
  64.          (random-thread-error c port))
  65.             (else (punt))))))
  66.  
  67. (define (random-thread-error c port)
  68.   (display "*** " port)
  69.   (write (current-thread) port)
  70.   (display " got an error:" port) ;(newline port)
  71.   (display-condition c port)
  72.   (terminate-current-thread))
  73.  
  74. ; Can we do better?...
  75.  
  76. ;(define (cp-start-multitasking)
  77. ;  (let ((mbx (make-mailbox)))
  78. ;    (lambda ()
  79. ;      (with-multitasking
  80. ;          (errant-thread-condition-handler mbx (current-output-port))
  81. ;        (lambda ()
  82. ;          ;; (add-sentinel! (errant-thread-sentinel mbx))
  83. ;          (with-keyboard-interrupt-thread
  84. ;              (current-thread)
  85. ;            breakpoint))))))            ;???
  86. ;
  87. ;(define (errant-thread-condition-handler mbx port)
  88. ;  (lambda (c punt)
  89. ;    (cond ((error? c)
  90. ;           (random-thread-error c mbx))
  91. ;          ((warning? c)                 ;Proceed
  92. ;           (display-condition c port)
  93. ;           (newline port)
  94. ;           (unspecific))
  95. ;          (else                         ;Proceed
  96. ;           (punt)))))
  97. ;
  98. ;(define (random-thread-error c mbx)
  99. ;  (let ((cv (make-condvar)))
  100. ;    (mailbox-write mbx (list c cv (current-thread)))
  101. ;    ((condvar-ref cv))))
  102.  
  103.  
  104. ; To do: make the command processor check the errant-thread mailbox.
  105.  
  106. ;(define (errant-thread-sentinel mbx)
  107. ;  (lambda ()
  108. ;    (if (not (mailbox-empty? mbx))
  109. ;        (begin (display .... ? ...) (newline)))))
  110. ;
  111. ;(add-sentinel! errant-thread-sentinel)
  112.  
  113.